packages = c('readxl', 'datawizard', 'crosstalk', 'tidyr', 'lubridate','tidyverse', 'plotly', 'd3scatter','tidyquant')
for(p in packages){
if(!require(p,character.only = T)){
install.packages(p)
}
library(p,character.only = T)
}1 The task
In this take-home exercise, you are required to uncover the impact of COVID-19 as well as the global economic and political dynamic in 2022 on Singapore bi-lateral trade (i.e. Import, Export and Trade Balance) by using appropriate analytical visualisation techniques learned in Lesson 6: It’s About Time. Students are encouraged to apply appropriate interactive techniques to enhance user and data discovery experiences.
The write-up of the take-home exercise should include but not limited to the followings:
- Describe the selection and designed consideration of the analytical data visualisation used. The discussion should limit to not more than 150 words each.
- A reproducible description of the procedures used to prepare the analytical visualisation. Please refer to the peer submission I shared.
- A write-up of not more than 100 words to discuss the patterns reveal by each analytical visualization prepared.
Packages
2 Data
Merchandise Trade provided by Department of Statistics, Singapore (DOS) is used. The study period is between January 2020 to December 2022.
Checking the number of sheets it contains
excel_sheets("data/data.xlsx")[1] "Content" "T1" "T2" Importing data
In the code chunk below, read_xlsx() of readxl package is used to import the data worksheet of our data workbook into R.
T1 <- read_xlsx("data/data.xlsx", sheet = "T1")
T2 <- read_xlsx("data/data.xlsx", sheet = "T2")Formatting data
# Transpose the fat table to long table
T1 <- gather(T1, "MonthYear", "ImportValue", -`Data Series`)
T2 <- gather(T2, "MonthYear", "ExportValue", -`Data Series`)
Note
ymd_hms() and hour() are from lubridate package
# Convert MonthYear column to date format
T1$`MonthYear` <- ym(T1$`MonthYear`)
T2$`MonthYear` <- ym(T2$`MonthYear`)
# Convert ImportValue column to numeric format
T1$`ImportValue` <- as.numeric(T1$`ImportValue`)
T2$`ExportValue` <- as.numeric(T2$`ExportValue`)Separate region and country
Code
# =================== Import =================== #
Region <- T1 %>%
filter(grepl('Million', `Data Series`)) %>%
rename("Region" = "ImportValue")
Country <- T1 %>%
filter(grepl('Thousand', `Data Series`)) %>%
rename("Country" = "ImportValue")
Import <- full_join(Region, Country, by = join_by(`Data Series`, `MonthYear`))
Import <- gather(Import , "Level", "ImportValue", -`Data Series`, -`MonthYear`)
# =================== Export =================== #
Region <- T2 %>%
filter(grepl('Million', `Data Series`)) %>%
rename("Region" = "ExportValue")
Country <- T2 %>%
filter(grepl('Thousand', `Data Series`)) %>%
rename("Country" = "ExportValue")
Export <- full_join(Region, Country, by = join_by(`Data Series`, `MonthYear`))
Export <- gather(Export , "Level", "ExportValue", -`Data Series`, -`MonthYear`)Filter date and rename column
Import <- Import %>%
filter(`MonthYear`>= as.Date("2009-12-01")) %>%
rename(`Country` = `Data Series`)
Export <- Export %>%
filter(`MonthYear`>= as.Date("2009-12-01")) %>%
rename(`Country` = `Data Series`)Merge Import and Export into one table
data1 <- full_join(Import, Export, by = join_by(`Country`, `MonthYear`,`Level`))
data1 <- data1 %>%
mutate("Diff" = ImportValue-ExportValue)
data <- gather(data1 , "Type", "Value", -`Country`, -`MonthYear`,-`Level`)2.1 Table: Merchandise Imports/Export By Region/Market, Monthly
| Country | MonthYear | Level | ImportValue |
|---|---|---|---|
| America (Million Dollars) | 2022-12-01 | Region | 6901.5 |
| Asia (Million Dollars) | 2022-12-01 | Region | 33611.7 |
| Europe (Million Dollars) | 2022-12-01 | Region | 7541.8 |
| Oceania (Million Dollars) | 2022-12-01 | Region | 1399.9 |
| Africa (Million Dollars) | 2022-12-01 | Region | 414.9 |
| European Union (Million Dollars) | 2022-12-01 | Region | 5058.8 |
| America (Million Dollars) | 2022-11-01 | Region | 7529.4 |
| Asia (Million Dollars) | 2022-11-01 | Region | 34733.7 |
| Europe (Million Dollars) | 2022-11-01 | Region | 7242.8 |
| Oceania (Million Dollars) | 2022-11-01 | Region | 664.4 |
| Country | MonthYear | Level | ExportValue |
|---|---|---|---|
| America (Million Dollars) | 2022-12-01 | Region | 6217.5 |
| Asia (Million Dollars) | 2022-12-01 | Region | 39734.8 |
| Europe (Million Dollars) | 2022-12-01 | Region | 4924.4 |
| Oceania (Million Dollars) | 2022-12-01 | Region | 3034.8 |
| Africa (Million Dollars) | 2022-12-01 | Region | 1088.6 |
| European Union (Million Dollars) | 2022-12-01 | Region | 4137.1 |
| America (Million Dollars) | 2022-11-01 | Region | 6394.2 |
| Asia (Million Dollars) | 2022-11-01 | Region | 37973.2 |
| Europe (Million Dollars) | 2022-11-01 | Region | 5025.2 |
| Oceania (Million Dollars) | 2022-11-01 | Region | 3243.1 |
2.2 Scatter plot Dashboard
Code
hline <- function(y = 0, color = "steelblue") {
list(
type = "line",
x0 = 0, x1 = 1,
xref = "paper",
y0 = y, y1 = y,
line = list(color = color, dash="dot")
)
}
vline <- function(x = 0, color = "steelblue") {
list(
type = "line",
y0 = 0, y1 = 1,
yref = "paper",
x0 = x, x1 = x,
line = list(color = color, dash="dot")
)
}
fig <- data1 %>%
plot_ly(
x = ~`ImportValue`,
y = ~`ExportValue`,
color = ~`Country`,
frame = ~year(`MonthYear`),
text= ~paste("Country:",`Country`,
"\nImport Value:", `ImportValue`,
"\nExport Value:", `ExportValue`,
"\nMonth Year:", `MonthYear`),
hoverinfo = "text",
type = 'scatter',
mode = 'markers'
)
annotations = list(
list(
x = 0.25,
y = 0.85,
font = list(size = 10),
text = "Low Import - High Export",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "center",
showarrow = FALSE
),
list(
x = 0.8,
y = 0.85,
font = list(size = 10),
text = "High Import - High Export",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "center",
showarrow = FALSE
),
list(
x = 0.25,
y = 0.35,
font = list(size = 10),
text = "Low Import - Low Export",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "center",
showarrow = FALSE
),
list(
x = 0.8,
y = 0.35,
font = list(size = 10),
text = "High Import - Low Export",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "center",
showarrow = FALSE
)
)
fig <- fig %>%
layout(title = list(text="Import - Export"),
hoverlabel = list(align = "left"),
shapes = list(hline(5000000), vline(5000000)),
annotations = annotations,
legend = list(orientation = "h", y = 1, x = 0),
showlegend = FALSE,
xaxis = list(title="Import Value", range = list(0, 10000000)),
yaxis = list(title="Export Value", range = list(0, 10000000))
)
fig <- fig %>%
animation_opts(
2000, easing = "linear", redraw = FALSE
)
fig
Insights
- Mainland China is the only nation with a High Import - High Export spectrum. From 2020 to 2021, there was a significant increase in value, particularly export value.
- Taiwan import rate has continuously grown but we can observed significant jump of import value in 2021 after COVID.
# Prepare data for plotting
scatter <- data1 %>%
filter(Level=="Country")
# Building interactive filters
d <- highlight_key(scatter)
filter_tools <- htmltools::div(
filter_slider(id = "period",
label = "Select period",
sharedData = d,
column = ~MonthYear,
dragRange = TRUE,
step = 30,
animate = TRUE,
width = "100%",
)
)
# plotting interactive scatter plot using plotly
p <- plot_ly(data=d,
x = ~`ImportValue`,
y = ~`ExportValue`,
type= "scatter",
mode= "markers",
color= ~`Country`,
symbol = ~`Level`,
colors = "Accent",
marker= list(size=5, opacity = 0.5,
line=list(width=0.2, color="black")),
text= ~paste("Country:",`Country`,
"\nImport Value:", `ImportValue`,
"\nExport Value:", `ExportValue`))
p <- p %>%
layout(title = list(text="<b>Xxxxxxxxxxxxxxxx</b>"),
hoverlabel = list(align = "left"),
legend = list(orientation = "h", y = 1.5, x = 0),
showlegend = FALSE,
xaxis = list(title="Import Value", range = list(0, 10000000)),
yaxis = list(title="Export Value", range = list(0, 10000000))
)
p <- p %>%
animation_opts(
1000, easing = "elastic", redraw = FALSE
)
gg <- highlight(p, "plotly_selected")
crosstalk::bscols(filter_tools,gg, widths = c(10, 12))2.3 Interactive Dashboard
# Building interactive filters
scatter <- data1 %>%
filter(Level=="Country")
d <- highlight_key(data)
filter_tools <- htmltools::div(
filter_select(id = "country",
label = "Select Country",
sharedData = d,
group = ~Country),
filter_checkbox(id = "variable",
label = "Select variable",
sharedData = d,
group = ~Type,
inline = TRUE),
filter_slider(id = "period",
label = "Select period",
sharedData = d,
column = ~MonthYear,
width = "100%"))
bscols(
d3scatter(data = scatter,
x = ~`ImportValue`,
y = ~`ExportValue`,
color = ~`Country`,
# point_size = 50,
# point_opacity = 0.5,
# colors = "#A94175",
width = "100%",
height = 500
# fixed = FALSE,
# xlim = c(0, 100000),
# ylim = c(0, 200000),
# xlab = "Import",
# ylab = "Export",
# axes_font_size = "100%",
# lab = ~`Country`
)
)# # plotting interactive scatter plot using plotly
# p <- plot_ly(data=d,
# type= "scatter",
# mode= "markers",
# x= ~lease_commence_date,
# y= ~resale_price,
# color= ~storey,
# colors= "Accent",
# marker= list(size=5, opacity = 0.5,
# line=list(width=0.2, color="black")),
# text= ~paste("Town:",town,
# "\nYear:",lease_commence_date,
# "\nLocation:",address,
# "\nType:",flat_type,
# "\nResale Price:",prettyNum(resale_price,big.mark=","),
# "\nStorey:",storey_range,
# "\nNearest MRT:",nearest_mrt," ~",nearest_distance_to_mrt,"km"
# )) %>%
# layout(title = list(text="<b>Xxxxxxxxxxxxxxxx</b>"),
# hoverlabel = list(align = "left"),
# legend = list(orientation = "h", y = 1, x = 0),
# xaxis = list(title="Lease Commencement Year"),
# yaxis = list(title="Resale Price (S$)"))
# gg <- highlight(p, "plotly_selected")
# Using crosstalk bscols to put all 3 elements (filter, scatter plot, datatable) together.
crosstalk::bscols(filter_tools,DT::datatable(d, class= "display",
filter=list(position="top", clear=FALSE),
options=list(pageLength = 10,scrollY = TRUE,
iDisplayLength = 25),
),
widths = c(3,12),
annotations = list(caption = "Data from Department of Statistics, Singapore (DOS)"))